home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / spaces2d.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  128 lines
  1. /********************************\
  2. ** Spaces2D v1.0 for Solitarexx **
  3. **     by Michal Szafranski     **
  4. \********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Spaces 2D v1.0"'
  8. win = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDCYCLE 1 6 '0|1|2|3|4|5' 2 'Reshuffles' 12
  11. ADDTEXT 4 24 tex 6
  12. ADDBUTTON 12 10 "Abort"
  13. ADDBUTTON 13 12 'Reshuffle'
  14. ADDTEXT 14 30 tex 6
  15. SELECTGUI 1
  16. SCREENSIZE 8 0 13 0
  17. DO i = 0 TO 103
  18.     NEWSTACK i 0 0 (i//13) (i%13)
  19.     stack.i = RESULT
  20. END
  21. NEWSTACK 0 128
  22. deck = RESULT
  23. NEWSTACK 0 128
  24. waste = RESULT
  25. ADDCARDS deck
  26. ADDCARDS deck SHUFFLED
  27.  
  28. DO FOREVER
  29.     ACTION
  30.     PARSE VAR RESULT act rest
  31.     IF act = 1 THEN EXIT
  32.     IF act = 3 THEN CALL GAME
  33. END
  34.  
  35. GAME:
  36.     SETGADGET 14 STR tex
  37.     CLEANUP deck
  38.     SELECTGUI 4
  39.     GETGADGET 1
  40.     shuff = RESULT
  41.     fin. = 0
  42.     CALL DODECK
  43.     DO FOREVER
  44.         ACTION
  45.         PARSE VAR RESULT act stack sid card
  46.         SELECT
  47.         WHEN act = 1 THEN EXIT
  48.         WHEN act = 2 & card > 0 THEN CALL DOMOVE
  49.         WHEN act = 3 & stack = 13 & shuff>0 THEN CALL DOSHUFFLE
  50.         WHEN act = 3 & stack = 12 THEN DO
  51.             SELECTGUI 1
  52.             RETURN
  53.         END
  54.         OTHERWISE ERRBEEP
  55.         END
  56.     END
  57. RETURN
  58. DODECK:
  59.     DO jj = 0 TO 7
  60.         DO ii = fin.jj TO 12
  61.             i = 13*jj+ii
  62.             CARDSELECT deck 1
  63.             PARSE VAR RESULT kol.i war.i .
  64.             mm = stack.i
  65.             IF war.i = 0 THEN DO
  66.                 mm = waste
  67.                 kol.i = -1
  68.             END
  69.             MOVECARDS deck mm REVERSE
  70.         END
  71.     END
  72. RETURN
  73. DOMOVE:
  74.     i = sid
  75.     l = (sid+103)//104
  76.     ok = 0
  77.     DO WHILE ok = 0 & i~= l
  78.         i = (i+1)//104
  79.         IF war.i = 0 THEN DO
  80.             pos = i//13
  81.             IF pos=0 & war.sid = 1 THEN ok = 1
  82.             ELSE IF pos>0 THEN DO
  83.                 ip = i-1
  84.                 IF war.sid - war.ip = 1 & kol.ip = kol.sid THEN ok = 1
  85.             END
  86.         END
  87.     END
  88.     IF ok=1 THEN DO
  89.         war.i = war.sid
  90.         kol.i = kol.sid
  91.         kol.sid = -1
  92.         war.sid = 0
  93.         MOVECARDS stack stack.i
  94.         CALL CHECK
  95.     END
  96.     ELSE ERRBEEP
  97. RETURN
  98. DOSHUFFLE:
  99.     shuff = shuff-1
  100.     DO jj = 0 TO 7
  101.         DO ii = fin.jj TO 12
  102.             i = 13*jj+ii
  103.             CARDSELECT stack.i 1
  104.             MOVECARDS stack.i deck REVERSE
  105.         END
  106.     END
  107.     CARDSELECT waste 8
  108.     MOVECARDS waste deck REVERSE
  109.     SHUFFLECARDS deck
  110.     CALL DODECK
  111.     CALL CHECK
  112. RETURN
  113. CHECK:
  114.     fin = 0
  115.     DO jj = 0 TO 7
  116.         p = 13*jj
  117.         ii = 0
  118.         i = p
  119.         DO WHILE kol.i=kol.p & war.i=ii+1
  120.             i = i+1
  121.             ii = ii+1
  122.         END
  123.         fin.jj = ii
  124.         fin = fin+fin.jj
  125.     END
  126.     IF fin = 96 THEN SETGADGET 14 STR win
  127. RETURN
  128.